home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / language / pcl_src.zoo / pkg.lsp < prev    next >
Encoding:
Text File  |  1992-09-09  |  10.9 KB  |  375 lines
  1. ;;;-*-Mode:LISP; Package:(PCL (LISP WALKER)); Base:10; Syntax:Common-lisp -*-
  2. ;;;
  3. ;;; *************************************************************************
  4. ;;; Copyright (c) 1985, 1986, 1987, 1988, 1989, 1990 Xerox Corporation.
  5. ;;; All rights reserved.
  6. ;;;
  7. ;;; Use and copying of this software and preparation of derivative works
  8. ;;; based upon this software are permitted.  Any distribution of this
  9. ;;; software or derivative works must comply with all applicable United
  10. ;;; States export control laws.
  11. ;;; 
  12. ;;; This software is made available AS IS, and Xerox Corporation makes no
  13. ;;; warranty about the software, its performance or its conformity to any
  14. ;;; specification.
  15. ;;; 
  16. ;;; Any person obtaining a copy of this software is requested to send their
  17. ;;; name and post office or electronic mail address to:
  18. ;;;   CommonLoops Coordinator
  19. ;;;   Xerox PARC
  20. ;;;   3333 Coyote Hill Rd.
  21. ;;;   Palo Alto, CA 94304
  22. ;;; (or send Arpanet mail to CommonLoops-Coordinator.pa@Xerox.arpa)
  23. ;;;
  24. ;;; Suggestions, comments and requests for improvements are also welcome.
  25. ;;; *************************************************************************
  26. ;;;
  27.  
  28. (in-package ':walker :use '(:lisp))
  29.  
  30. (export '(define-walker-template
  31.       walk-form
  32.       walk-form-expand-macros-p
  33.       nested-walk-form
  34.       variable-lexical-p
  35.       variable-special-p
  36.       variable-globally-special-p
  37.       *variable-declarations*
  38.       variable-declaration
  39.       ))
  40.  
  41. (in-package :iterate :use '(:lisp :walker))
  42.  
  43. (export '(iterate iterate* gathering gather with-gathering interval elements 
  44.       list-elements list-tails plist-elements eachtime while until 
  45.       collecting joining maximizing minimizing summing 
  46.       *iterate-warnings*))
  47.  
  48. (in-package :pcl :use '(:lisp :walker :iterate))
  49.  
  50. ;;;
  51. ;;; Some CommonLisps have more symbols in the Lisp package than the ones that
  52. ;;; are explicitly specified in CLtL.  This causes trouble. Any Lisp that has
  53. ;;; extra symbols in the Lisp package should shadow those symbols in the PCL
  54. ;;; package.
  55. ;;;
  56. #+TI
  57. (shadow '(string-append once-only destructuring-bind
  58.       memq assq delq neq true false
  59.       without-interrupts
  60.       defmethod)
  61.     *the-pcl-package*)
  62.  
  63. #+CMU
  64. (shadow '(destructuring-bind)
  65.         *the-pcl-package*)
  66.  
  67. #+GCLisp
  68. (shadow '(string-append memq assq delq neq make-instance)
  69.     *the-pcl-package*)
  70.  
  71. #+Genera
  72. (shadowing-import '(zl:arglist zwei:indentation) *the-pcl-package*)
  73.  
  74. #+Lucid 
  75. (import '(#-LCL3.0 system:arglist #+LCL3.0 lcl:arglist
  76.       system:structurep system:structure-type system:structure-length
  77.           #-(or *lisp-hardware *lisp-simulator) lucid::boolean
  78.           #+*lisp-hardware *lisp:boolean)
  79.     *the-pcl-package*)
  80.  
  81.  
  82. #+lucid
  83. (#-LCL3.0 progn #+LCL3.0 lcl:handler-bind 
  84.     #+LCL3.0 ((lcl:warning #'(lambda (condition)
  85.                    (declare (ignore condition))
  86.                    (lcl:muffle-warning))))
  87. (let ((importer
  88.         #+LCL3.0 #'sys:import-from-lucid-pkg
  89.     #-LCL3.0 (let ((x (find-symbol "IMPORT-FROM-LUCID-PKG" "LUCID")))
  90.            (if (and x (fboundp x))
  91.                (symbol-function x)
  92.                ;; Only the #'(lambda (x) ...) below is really needed, 
  93.                ;;  but when available, the "internal" function 
  94.                ;;  'import-from-lucid-pkg' provides better checking.
  95.                #'(lambda (name)
  96.                (import (intern name "LUCID")))))))
  97.   ;;
  98.   ;; We need the following "internal", undocumented Lucid goodies:
  99.   (mapc importer '("%POINTER" "DEFSTRUCT-SIMPLE-PREDICATE"
  100.            #-LCL3.0 "LOGAND&" "%LOGAND&" #+VAX "LOGAND&-VARIABLE"))
  101.  
  102.   ;;
  103.   ;; For without-interrupts.
  104.   ;; 
  105.   #+LCL3.0
  106.   (mapc importer '("*SCHEDULER-WAKEUP*" "MAYBE-CALL-SCHEDULER"))
  107.  
  108.   ;;
  109.   ;; We import the following symbols, because in 2.1 Lisps they have to be
  110.   ;;  accessed as SYS:<foo>, whereas in 3.0 lisps, they are homed in the
  111.   ;;  LUCID-COMMON-LISP package.
  112.   (mapc importer '("ARGLIST" "NAMED-LAMBDA" "*PRINT-STRUCTURE*"))
  113.   ;;
  114.   ;; We import the following symbols, because in 2.1 Lisps they have to be
  115.   ;;  accessed as LUCID::<foo>, whereas in 3.0 lisps, they have to be
  116.   ;;  accessed as SYS:<foo>
  117.   (mapc importer '(
  118.            "NEW-STRUCTURE"       "STRUCTURE-REF"
  119.            "STRUCTUREP"         "STRUCTURE-TYPE"  "STRUCTURE-LENGTH"
  120.            "PROCEDUREP"         "PROCEDURE-SYMBOL"
  121.            "PROCEDURE-REF"     "SET-PROCEDURE-REF" 
  122.            ))
  123. ; ;;
  124. ; ;;  The following is for the "patch" to the general defstruct printer.
  125. ; (mapc importer '(
  126. ;                "OUTPUT-STRUCTURE"       "DEFSTRUCT-INFO"
  127. ;           "OUTPUT-TERSE-OBJECT"  "DEFAULT-STRUCTURE-PRINT" 
  128. ;           "STRUCTURE-TYPE"       "*PRINT-OUTPUT*"
  129. ;           ))
  130.   ;;
  131.   ;; The following is for a "patch" affecting compilation of %logand&.
  132.   ;; On APOLLO, Domain/CommonLISP 2.10 does not include %logand& whereas
  133.   ;; Domain/CommonLISP 2.20 does; Domain/CommonLISP 2.20 includes :DOMAIN/OS
  134.   ;; on *FEATURES*, so this conditionalizes correctly for APOLLO.
  135.   #-(or (and APOLLO DOMAIN/OS) LCL3.0 VAX) 
  136.   (mapc importer '("COPY-STRUCTURE"  "GET-FDESC"  "SET-FDESC"))
  137.   
  138.   nil))
  139.  
  140. #+kcl
  141. (progn
  142. (import '(system:structurep))
  143. (shadow 'lisp:dotimes)
  144. )
  145. #+kcl
  146. (in-package "SI")
  147. #+kcl
  148. (export '(%structure-name
  149.           %compiled-function-name
  150.           %set-compiled-function-name))
  151. #+kcl
  152. (in-package 'pcl)
  153.  
  154. #+cmu (shadow 'lisp:dotimes)
  155.  
  156. #+cmu
  157. (import '(kernel:funcallable-instance-p ext:structurep c::boolean)
  158.     *the-pcl-package*)
  159.  
  160. #+CMU
  161. (eval-when (compile)
  162.   (setq c:*suppress-values-declaration* T))
  163.  
  164. #+*lisp-simulator
  165. (import '*sim::boolean)
  166.  
  167. #-(or cmu lucid *lisp-simulator)
  168. (deftype boolean () '(member t nil))
  169.  
  170. #+(and coral cltl2)
  171. (progn
  172.   (setq ccl:*autoload-lisp-package* 't)
  173.   (pushnew ':setf cl:*features*)
  174. ;  (use-package :lisp)
  175.   (import 'cl:fdefinition))
  176.  
  177.  
  178. (shadow 'documentation)
  179.  
  180.  
  181. ;;;                        
  182. ;;; These come from the index pages of 88-002R.
  183. ;;;
  184. ;;;
  185. (eval-when (compile load eval)  
  186.   
  187. (defvar *exports* '(add-method
  188.             built-in-class
  189.             call-method
  190.             call-next-method
  191.             change-class
  192.             class-name
  193.             class-of
  194.             compute-applicable-methods
  195.             defclass
  196.             defgeneric
  197.             define-method-combination
  198.             defmethod
  199.             describe-object
  200.             ensure-generic-function
  201.             find-class
  202.             find-method
  203.             function-keywords
  204.             generic-flet
  205.             generic-labels
  206.             initialize-instance
  207.             invalid-method-error
  208.             make-instance
  209.             make-instances-obsolete
  210.             method-combination-error
  211.             method-qualifiers
  212.             next-method-p
  213.             no-applicable-method
  214.             no-next-method
  215.             print-object
  216.             reinitialize-instance
  217.             remove-method
  218.             shared-initialize
  219.             slot-boundp
  220.             slot-exists-p
  221.             slot-makunbound
  222.             slot-missing
  223.             slot-unbound
  224.             slot-value
  225.             standard
  226.             standard-class
  227.             standard-generic-function
  228.             standard-method
  229.             standard-object
  230.             structure-class
  231.             #-cmu symbol-macrolet
  232.             update-instance-for-different-class
  233.             update-instance-for-redefined-class
  234.             with-accessors
  235.             with-added-methods
  236.             with-slots
  237.             ))
  238.  
  239. );eval-when 
  240.  
  241. #-(or KCL IBCL CMU)
  242. (export *exports* *the-pcl-package*)
  243.  
  244. #+CMU
  245. (export '#.*exports* *the-pcl-package*)
  246.  
  247. #+(or KCL IBCL)
  248. (mapc 'export (list *exports*) (list *the-pcl-package*))
  249.  
  250.  
  251. (eval-when (compile load eval)  
  252.   
  253. (defvar *class-exports*
  254.         '(standard-instance
  255.           funcallable-standard-instance
  256.           generic-function
  257.           standard-generic-function
  258.           method
  259.           standard-method
  260.           standard-accessor-method
  261.           standard-reader-method
  262.           standard-writer-method
  263.           method-combination
  264.           slot-definition
  265.           direct-slot-definition
  266.           effective-slot-definition
  267.           standard-slot-definition
  268.           standard-direct-slot-definition
  269.           standard-effective-slot-definition
  270.           specializer
  271.           eql-specializer
  272.           built-in-class
  273.           forward-referenced-class
  274.           standard-class
  275.           funcallable-standard-class))
  276.  
  277. (defvar *chapter-6-exports*
  278.         '(add-dependent
  279.           add-direct-method
  280.           add-direct-subclass
  281.           add-method
  282.           allocate-instance
  283.           class-default-initargs
  284.           class-direct-default-initargs
  285.           class-direct-slots
  286.           class-direct-subclasses
  287.           class-direct-superclasses
  288.           class-finalized-p
  289.           class-precedence-list
  290.           class-prototype
  291.           class-slots
  292.           compute-applicable-methods
  293.           compute-applicable-methods-using-classes
  294.           compute-class-precedence-list
  295.           compute-discriminating-function
  296.           compute-effective-method
  297.           compute-effective-slot-definition
  298.           compute-slots
  299.           direct-slot-definition-class
  300.           effective-slot-definition-class
  301.           ensure-class
  302.           ensure-class-using-class
  303.           ensure-generic-function
  304.           ensure-generic-function-using-class
  305.           eql-specializer-instance
  306.           extract-lambda-list
  307.           extract-specializer-names
  308.           finalize-inheritance
  309.           find-method-combination
  310.           funcallable-standard-instance-access
  311.           generic-function-argument-precedence-order
  312.           generic-function-declarations
  313.           generic-function-lambda-list
  314.           generic-function-method-class
  315.           generic-function-method-combination
  316.           generic-function-methods
  317.           generic-function-name
  318.           intern-eql-specializer
  319.           make-instance
  320.           make-method-lambda
  321.           map-dependents
  322.           method-function
  323.           method-generic-function
  324.           method-lambda-list
  325.           method-specializers
  326.           method-qualifiers
  327.           accessor-method-slot-definition
  328.           reader-method-class
  329.           remove-dependent
  330.           remove-direct-method
  331.           remove-direct-subclass
  332.           remove-method
  333.           set-funcallable-instance-function
  334.           slot-boundp-using-class
  335.           slot-definition-allocation
  336.           slot-definition-initargs
  337.           slot-definition-initform
  338.           slot-definition-initfunction
  339.           slot-definition-location
  340.           slot-definition-name
  341.           slot-definition-readers
  342.           slot-definition-writers
  343.           slot-definition-type
  344.           slot-exists-p-using-class
  345.           slot-makunbound-using-class
  346.           slot-value-using-class
  347.           specializer-direct-generic-function
  348.           specializer-direct-methods
  349.           standard-instance-access
  350.           update-dependent
  351.           validate-superclass
  352.           writer-method-class
  353.           ))
  354.  
  355. );eval-when 
  356.  
  357. #-(or KCL IBCL)
  358. (export *class-exports* *the-pcl-package*)
  359.  
  360. #+(or KCL IBCL)
  361. (mapc 'export (list *class-exports*) (list *the-pcl-package*))
  362.  
  363. #-(or KCL IBCL)
  364. (export *chapter-6-exports* *the-pcl-package*)
  365.  
  366. #+(or KCL IBCL)
  367. (mapc 'export (list *chapter-6-exports*) (list *the-pcl-package*))
  368.  
  369. (defvar *slot-accessor-name-package*
  370.   (or (find-package :slot-accessor-name)
  371.       (make-package :slot-accessor-name 
  372.             :use '()
  373.             :nicknames '(:s-a-n))))
  374.  
  375.